home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 4 / Mac Giga-ROM 4.0 - 1993.toast / FILES / DEV / I-Z / ViewIt™ Shareware.sea / ViewIt™ 2.04 Shareware / Projects / Fortran Demos / fDemoAF.f < prev    next >
Text File  |  1992-08-12  |  4KB  |  137 lines
  1. C NOTE: Read the "MPW Fortrans" section of "About Compilers"
  2. C before compiling AF programs that use FaceWare modules.
  3.  
  4. C FaceIt 2.04 Demonstration Program
  5. C ©FaceWare 1989-92.  All Rights Reserved.
  6. C1 - run program to see on-line comments
  7.  
  8.     GLOBAL DEFINE
  9.     include "Types.inc"
  10.     include "QuickDraw.inc"
  11.     include "ToolUtils.inc"
  12.     include "Controls.inc"
  13.     include "Events.inc"
  14.     include "OSUtils.inc"
  15.     include "OSEvents.inc"
  16.     include "SegLoad.inc"
  17.     include "Files.inc"
  18.     include "Resources.inc"
  19.     include "FaceStorAF.inc"
  20.     END
  21. C2
  22.     include "FaceProcAF.inc"
  23.  
  24.       PROGRAM fDemoAF
  25.     implicit none
  26.       record /FaceRec/ fRec
  27.       common/FaceStuff/fRec
  28.     integer*1 keys(16)
  29.     integer*2 i,mode
  30.     integer*4 oldCount,newCount
  31.     character*256 fileName
  32. C3
  33.       fRec.uName = 'fDemo.Rsrc'
  34. C4,5
  35.       call FaceIt(0,DoInit,515,0,0,0)
  36. C6
  37.     call FaceIt(0,NewWnd,1030,1,0,0)
  38. C7
  39.       do while (.true.)
  40.         call FaceIt(0,DoLoop,0,0,0,0)
  41. C8
  42. C9
  43.         if (fRec.uMenuID == 101) then
  44.         if (fRec.uMenuItem == 1) then
  45.           fRec.uString = 'Demonstration of the use of FaceIt'
  46.      +//char(13)//'to support program-wide features.'
  47.           call FaceIt(0,ShoStr,3,12,(1 + (409*65536)),0)
  48.         end if
  49. C10
  50.       else if ((fRec.uMenuID >= 105).and.(fRec.uMenuID <= 107)) then
  51. C11
  52.         if (fRec.uMenuItem == 1) then
  53.           call SysBeep(%val2(5))
  54.         else if (fRec.uMenuItem == 2) then
  55.           call SysBeep(%val2(5))
  56.           call SysBeep(%val2(5))
  57.         else if (fRec.uMenuItem == 3) then
  58.           call SysBeep(%val2(5))
  59.           call SysBeep(%val2(5))
  60.           call SysBeep(%val2(5))
  61. C12
  62.         else if (fRec.uMenuItem == 8) then
  63. C13
  64.         call FaceIt(0,ShoAlt,1010,0,1,1)
  65.         mode = fRec.uResult
  66.         oldCount = 0
  67.         if (mode > 1) then
  68.           do while (.true.)
  69. C14
  70.             newCount = TickCount()
  71.             if (newCount - oldCount > 180) then
  72.               call SysBeep(%val2(5))
  73.             oldCount = newCount
  74.             end if
  75. C15
  76.             if (mode == 2) then
  77.               if (GetNextEvent(%val2(-1),fRec.fEvent) <> 0) then
  78.               if ((fRec.fEvent(1) == 6).or.
  79.      +           (fRec.fEvent(1) == 15)) then
  80.                 call FaceIt(0,DoEvnt,0,0,0,0)
  81.               else if (fRec.fEvent(1) == 5) then
  82.                 exit
  83.               end if
  84.             end if
  85.             end if
  86. C16
  87.             if (mode == 3) then
  88.               call GetKeys(keys)
  89.             if ((BitTst(keys,%val4(61))<>0)
  90.      +         .and.(BitTst(keys,%val4(48))<>0)) then
  91.               call FlushEvents(%val2(62),%val2(0))
  92.               exit
  93.             end if
  94.             end if
  95.           end do
  96.         end if
  97.         end if
  98. C17
  99.       else if (fRec.uMenuID == 1030) then
  100.         if (fRec.wcHit > 3) then
  101.           call FaceIt(0,GetCtl,1030,0,1,4)
  102.           call FaceIt(0,PopMen,107,fRec.cRect(1)-5,fRec.cRect(2)-11,0)
  103.         fRec.wcHit = fRec.uMenuItem
  104.         end if
  105.         if (fRec.wcHit > 0) then
  106.           do (i = 1,fRec.wcHit)
  107.           call SysBeep(%val2(5))
  108.         end do
  109.         end if
  110. C18
  111.       else if (fRec.uMenuID == 1100) then
  112.         if (fRec.uMenuItem == 2) then
  113.           if (fRec.fActiveWnd == 0) then
  114.           fRec.uString = 'No Window'
  115.         else if (fRec.fActiveID <> 1200) then
  116.           fRec.uString = 'Non-ViewIt Window'
  117.         else if (fRec.fActiveResID == 1010) then
  118.           fRec.uString = 'Editor Window'
  119.         else if (fRec.fActiveResID == 1020) then
  120.           fRec.uString = 'Clipboard Window'
  121.         else if (fRec.fActiveResID == 1030) then
  122.           fRec.uString = 'Beeps Window'
  123.         end if
  124.         call FaceIt(0,SetItm2,105,10,3,0)
  125. C19
  126.         else if (fRec.uMenuItem == 512) then
  127.           if ((fRec.uString == 'TEXT').and.(fRec.uResult == 1)) then
  128.           fileName = fRec.uName
  129.           call FaceIt(0,GetCtl,1010,0,1,1)
  130.           fRec.uName = fileName
  131.           call FaceIt(fRec.cControl,1551,0,1,0,0) !OpnCTxt
  132.         end if
  133.         end if
  134.       end if
  135.       end do
  136.       end
  137.